home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / apps / 84 / applic / labels.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-19  |  28.3 KB  |  851 lines
  1. PROGRAM labels ;
  2.  
  3.         { GEM program to create labels of any size - uses menu and
  4.           forms to allow user to select size and font settings then
  5.           edit a form }
  6.  
  7. { for ATARI 520ST computer with printer }
  8. { version for GEMINI 10X printer - see control codes below }
  9.  
  10. { by Ron Rautenberg           Feb/Mar 1986
  11.      15 San Juan Dr
  12.      Salinas, Ca 93901
  13.         408-757-6481 }
  14.  
  15. {  VERSION 1.1
  16.    MODIFIED
  17.         16 Mar          -  check for printer offline b4 printing
  18.                         -  remove comments from Delete_Dialog to free space
  19.         17 Mar          -  lots of cosmetic improvements
  20.                                 box around label
  21.                                 works in low,med res - should work in high
  22.  
  23. }
  24.  
  25. CONST
  26.     {$I GEMCONST.PAS}
  27.  
  28. {  printer control codes - modify these for your printer }
  29. {  format of the strings is paramount!! - decimal codes separated by commas }
  30. {  ONLY ascii values in the range 0-127 acceptable }
  31.  
  32. { used to check if a print style is available - as set by LMINSTAL.PRG }
  33.         MARKER = '99,99,99';
  34.  
  35.                  {  Program LMINSTAL will modify these }
  36. { Software Reset }
  37.         SW_RESET = '27,64,00';
  38.  
  39. { Normal print mode - 10 cpi  should be done by SW_RESET }
  40.         NORMPRT = '27,66,01';
  41. { Elongated print - or double wide }
  42.         ELONGPRT = '27,87,01';
  43. { Condensed print }
  44.         CONDPRT = '27,15,00';
  45.  
  46. { To select 8 lines per inch }
  47.         EIGHTPER = '27,48,00';
  48. { To select 6 lines per inch }
  49.         SIXPER = '27,50,00';
  50.  
  51. { Turn underline mode on }
  52.         UL_ON = '27,45,01';
  53. { Turn underline mode off }
  54.         UL_OFF = '27,45,00';
  55. { Turn italics on }
  56.         ITALIC_ON = '27,52,00';
  57. { Italics off }
  58.         ITALIC_OFF = '27,53,00';
  59. { Bold or Emphasized print - you may use double strike }
  60.         BOLD_ON = '27,69,00';
  61. { To cancel Bold print }
  62.         BOLD_OFF = '27,70,00';
  63.  
  64.         MAGIC = '$3ABH';        { To allow install pgm to find constants }
  65.  
  66.         CPI_COND = 17;          { chars per inch - condensed mode }
  67.         CPI_NORM = 10;          { normal }
  68.         CPI_ELON = 5;           { elongated or double wide }
  69.  
  70.         LPI_NORM = 6;           { standard lines per inch }
  71.         LPI_COND = 8;           { condensed lines per inch }
  72.  
  73.         MAXLINES = 15;          { maximum size of form }
  74.         MAXCHARS = 70;
  75.  
  76.         DESK_TITLE = 3;
  77.  
  78.   TYPE
  79.     {$I gemtype.pas}
  80.  
  81.   VAR
  82.  
  83.         { menu items must all be globals !!!}
  84.  
  85.         the_menu : Menu_Ptr;    { pointer to the menu itself }
  86.  
  87.         lab_title,
  88.         style_title,            { the menu titles }
  89.         siz_title,
  90.  
  91.         lab_make,
  92.         lab_remake,
  93.         lab_print,              { the items under the label title }
  94.         lab_quit,
  95.  
  96.         pri_cond,
  97.         pri_norm,
  98.         pri_elon,               { the items under the printer title }
  99.         pri_ital,
  100.         pri_bold,
  101.         pri_underline,
  102.  
  103.         siz_small,
  104.         siz_large,              {the items under the size title }
  105.         siz_square,
  106.         siz_other : integer;
  107.  
  108.         numlines,               { number of printed lines per label }
  109.         totlines,               { total number of lines on a label }
  110.         numchars,               { number of chars per line  }
  111.  
  112.         cpi,lpi,                { chars per inch, lines per inch }
  113.  
  114.         print_size,             { the actual user selected values }
  115.         label_size: integer;
  116.  
  117.         label_len,label_wid : real ;
  118.  
  119.         bold,ital,underline : boolean;  { style states - on or off }
  120.  
  121.                         { the actual lines to print }
  122.         print_line : array[1..MAXLINES] of string[255];
  123.  
  124.         msg : Message_Buffer;   { the message returned when menu item sel. }
  125.  
  126.         init_wid,init_len : str255;     { initial values for <other> in sizes }
  127.  
  128.         dummy,which : integer ;
  129.  
  130. { *************************************************************************** }
  131.  
  132. {$I gemsubs}          { GEM subroutines }
  133.  
  134. FUNCTION Get_Rez : integer ;    { xbios call to get screen resolution }
  135.     XBIOS( 4 ) ;
  136. function C_Prnos : boolean;
  137.     GEMDOS ( 17 );
  138.  
  139. { *************************************************************************** }
  140.  
  141. function xor(b1,b2:boolean) : boolean;   { logical xor function }
  142.    begin
  143.         xor := (b1 or b2) and not (b1 and b2);
  144.    end;
  145.  
  146. { *************************************************************************** }
  147.  
  148. procedure set_size;
  149.  
  150.    var i : integer;
  151.  
  152. begin
  153.                              { calculate number of lines in label }
  154.    totlines := round(label_len * lpi);
  155.    numlines := totlines - 2;
  156.    if numlines > MAXLINES then numlines := MAXLINES;
  157.    numchars := round( (label_wid - 0.3) * cpi ) ;
  158.    if numchars > MAXCHARS then numchars := MAXCHARS;
  159.                              { chop off print_lines if necessary }
  160.    for i := 1 to numlines do
  161.      if Length(print_line[i]) > numchars then print_line[i,0] := chr(numchars);
  162. end;
  163.  
  164.  
  165. { *************************************************************************** }
  166.  
  167. procedure show_info;    { Tell 'em about me }
  168.  
  169. var msg : str255;
  170.      ok : integer;
  171.  
  172. begin
  173.      msg :=        '[0][     Label Maker   ver 1.1     |';
  174.      msg := concat(msg,'         public domain|  |');
  175.      msg := concat(msg,'       by Ron Rautenberg|  ][  OK  ]');
  176.  
  177.      ok := Do_Alert(msg,1);
  178. end;
  179.  
  180. { *************************************************************************** }
  181.  
  182. procedure initialize;   { initialize the globals }
  183.  
  184. var i : integer;
  185.  
  186. begin
  187.         Init_mouse;
  188.         Set_mouse(M_arrow);
  189.  
  190.         print_size := pri_norm;
  191.         label_size := siz_small;
  192.  
  193.         bold := false;
  194.         ital := false;
  195.         underline := false;
  196.  
  197.         init_wid := '';         { initial values for strings in size 'other' }
  198.         init_len := '';
  199.  
  200.         label_len := 1.0;
  201.         label_wid := 3.5;
  202.         lpi := LPI_NORM;
  203.         cpi := CPI_NORM;
  204.         set_size;
  205.         for i := 1 to MAXLINES do
  206.            print_line[i] := '';
  207. end;
  208.  
  209. { *************************************************************************** }
  210.  
  211. function stoi( s : str255 ) : integer;  { convert string s to integer }
  212.         { assumes s contains only numeric digits }
  213. var val,i : integer ;
  214.  
  215. begin
  216.     val := 0;
  217.     for i := 1 to Length( s ) do
  218.        val := val * 10 + ord( s[i] ) - ord ( '0' );
  219.     stoi := val;
  220. end;
  221.  
  222. { *************************************************************************** }
  223.  
  224. procedure show_edit_funcs;
  225.         { shows form edit functions available to user }
  226.  
  227.    var  help_box : dialog_ptr; { the form itself }
  228.         i,
  229.         ok_button,              { the exit button }
  230.         pushed : integer;       { button the user pushed }
  231.  
  232.         item : array[1..7] of integer;         { the text lines }
  233.         line : array[1..7] of string[48];
  234.  
  235. begin
  236.  
  237. { initialize the lines }
  238.         line[1] := '        EDIT FUNCTIONS';
  239.         line[2] := '';
  240.         line[3] := 'Esc       - Erases entire line';
  241.         line[4] := 'arrows    - Move up/down lines';
  242.         line[5] := 'arrows    - Move left/right';
  243.         line[6] := 'Delete    - Erase character right';
  244.         line[7] := 'Backspace - Erase character left';
  245.  
  246. { create the object }
  247.         help_box := New_Dialog(9,0,0,38,11);
  248.  
  249. { add the text lines }
  250.         for i := 1 to 7 do begin
  251.            item[i] := Add_DItem(help_box,G_String,None,2,i,48,1,0,0);
  252.            Set_Dtext(help_box,item[i],line[i],System_font,TE_Left);
  253.         end;
  254.  
  255. { add an ok button }
  256.         ok_button := Add_Ditem(help_box,G_Button,
  257.                 Selectable | Exit_Btn | Default,15,9,8,1,0,0);
  258.         set_Dtext(help_box,ok_button,'OK',System_font,TE_Center);
  259.  
  260. { reserve room to center the dialog }
  261.         Center_dialog(help_box);
  262.  
  263. { display the box }
  264.         pushed := Do_Dialog(help_box,0);
  265.  
  266. { erase it }
  267.         End_dialog(help_box);
  268.  
  269. { release the space }
  270.         Delete_Dialog(help_box);
  271. end;
  272.  
  273.  
  274. { *************************************************************************** }
  275.  
  276. function get_copies : integer;
  277.         { how many copies does user want? }
  278.  
  279.    const
  280.         PROMPT1 = ' Ensure Printer is On-line ';
  281.         PROMPT2 = 'How many copies?';
  282.  
  283.    var  copies_box : dialog_ptr; { the form itself }
  284.         prompt_item,            { the prompts }
  285.         print_button,           { the exit buttons }
  286.         abort_button,
  287.         line,                   { the edit line }
  288.         pushed : integer;       { button the user pushed }
  289.  
  290.         num_str : str255 ;
  291.  
  292. begin
  293.  
  294. { create the object }
  295.         copies_box := New_Dialog(6,0,0,31,10);
  296.  
  297. { add the prompt }
  298.      prompt_item := Add_Ditem(copies_box,g_boxtext,None,
  299.                         2,1,27,2,-1,(256+4096)*BLACK+128);
  300.      set_Dtext(copies_box,prompt_item,PROMPT1,System_font,TE_Center);
  301.      prompt_item := Add_Ditem(copies_box,g_text,None,2,4,27,1,0,256*BLACK+128);
  302.      set_Dtext(copies_box,prompt_item,PROMPT2,System_font,TE_Center);
  303.  
  304. { add an ok button }
  305.         print_button := Add_Ditem(copies_box,G_Button,
  306.                 Selectable | Exit_Btn | Default,4,8,8,1,0,0);
  307.         set_Dtext(copies_box,print_button,'PRINT',System_font,TE_Center);
  308.         abort_button := Add_Ditem(copies_box,G_Button,
  309.                 Selectable | Exit_Btn ,19,8,8,1,0,0);
  310.         set_Dtext(copies_box,abort_button,'ABORT',System_font,TE_Center);
  311.  
  312. { add edit lines }
  313.            line := Add_Ditem(copies_box,G_Ftext,None,
  314.                 2,6,26,1,0,256*Black + 128 );
  315.            set_Dedit(copies_box,line,'____','9999','1',
  316.                      System_font,TE_Center);
  317.  
  318. { reserve room to center the dialog }
  319.         Center_dialog(copies_box);
  320.  
  321. { display the box }
  322.         pushed := Do_Dialog(copies_box,line);
  323.  
  324. { erase it }
  325.         End_dialog(copies_box);
  326.  
  327.         if pushed = print_button then begin
  328. { find out what was entered }
  329.            Get_DEdit(copies_box,line,num_str);
  330.  
  331. { convert to integer and return }
  332.            get_copies := stoi(num_str);
  333.         end
  334.         else get_copies := 0;
  335.  
  336. { release the space }
  337.         Delete_Dialog(copies_box);
  338. end;
  339.  
  340. { *************************************************************************** }
  341.  
  342. procedure send_control(code:str255);
  343.     { sends printer control codes based on code string which is a
  344.       string of decimal digits separated by commas }
  345.  
  346. var
  347.     str,num_str,control : str255;
  348.     comma,number,i : integer;
  349.     prt : text;
  350.  
  351. begin
  352.     rewrite(prt,'lst:');
  353.  
  354.     control := '';              { init control string }
  355.     code := concat(code,',');   { tack a comma on end }
  356.     str[0] := chr(1);           { set length of temp string }
  357.     loop
  358.         comma := pos(',',code);         { find position of 1st comma }
  359.     exit if (comma = 0);
  360.         num_str := copy(code,1,comma-1);        { move digits to temp }
  361.         delete(code,1,comma);           { delete 1st number from string }
  362.         number := stoi(num_str);        { convert it to int }
  363.         str[1] := chr(number);          { and back to character }
  364.         control := concat(control,str); { and stick on end of control str }
  365.     end;
  366.  
  367.               { send it all to printer }
  368.     if C_Prnos then write(prt,control);
  369. end;
  370.  
  371. { *************************************************************************** }
  372.  
  373. procedure set_printer;  { sends controls to set printer to proper config }
  374.  
  375. var mag : string[5];    { dummy for LMINSTALL }
  376.  
  377. begin
  378.         mag := MAGIC;   { So LMINSTALL can find us }
  379.  
  380.         send_control(SW_RESET);
  381.  
  382.         case cpi of                             { chars per inch }
  383.            CPI_COND : send_control(CONDPRT);
  384.            CPI_NORM : send_control(NORMPRT);
  385.            CPI_ELON : send_control(ELONGPRT);
  386.            otherwise : ;
  387.         end;
  388.  
  389.         case lpi of                             { lines per inch }
  390.            LPI_NORM : send_control(SIXPER);
  391.            LPI_COND : send_control(EIGHTPER);
  392.            otherwise : ;
  393.         end;
  394.  
  395.        if bold then                     { bold }
  396.            send_control(BOLD_ON)
  397.        else if BOLD_ON <> MARKER then   { turn off bold in case it was on }
  398.            send_control(BOLD_OFF);      { only if it could have been on }
  399.  
  400.        if ital then                     { ditto italics }
  401.            send_control(ITALIC_ON)
  402.        else if ITALIC_ON <> MARKER then
  403.            send_control(ITALIC_OFF);
  404.  
  405.        if underline then                { ditto underline }
  406.            send_control(UL_ON)
  407.         else if UL_ON <> MARKER then
  408.            send_control(UL_OFF);
  409. end;
  410.  
  411. { *************************************************************************** }
  412.  
  413. procedure print_label;
  414.         { print the labels }
  415.  
  416. var  head,foot,                 { number of space lines to print }
  417.      line,copy,                 { loop control vars }
  418.      num_copies : integer;
  419.      error : real;              { difference between actual size of label and }
  420.                                 { the amount of output - cummulative }
  421.      printer : text ;
  422.      pushed : integer;
  423.  
  424. begin
  425.    rewrite(printer,'lst:');
  426.    num_copies := get_copies;
  427.    if num_copies > 0 then begin
  428.       pushed := 1;
  429.       if not C_Prnos then        { if the printer isn't ready }
  430.         pushed := Do_Alert('[2][   Check Printer...   |  ][  OK  | ABORT ]',1);
  431.       if (pushed = 1) and C_Prnos then begin
  432.          set_printer;
  433.          head := round((totlines - numlines)/2);
  434.          foot := totlines - numlines - head;
  435.          error := 0.0;
  436.          for copy := 1 to num_copies do begin
  437.             error := error+label_len - (totlines / lpi); { add to error value }
  438.             for line := 1 to head do writeln(printer);     { header space }
  439.  
  440.                 { print extra header line if error > half a line }
  441.             if error > (0.5 / lpi) then begin
  442.                writeln(printer);
  443.                error := error - ( 1.0 / lpi );        { and reduce the error }
  444.             end;
  445.  
  446.             for line := 1 to numlines do begin      {  put the label lines }
  447.                set_printer;      { every line - some codes turned off by CR }
  448.                writeln(printer,print_line[line]);
  449.             end;
  450.  
  451.             for line := 1 to foot -1 do writeln(printer);     { footer space }
  452.  
  453.                 { a full footer only if the error > negative half a line }
  454.             if error > (-0.5 / lpi) then  writeln(printer)
  455.             else  error := error + ( 1.0 / lpi);
  456.  
  457.          end; { for copy }
  458.       end; { if pushed }
  459.    end; { if copies > 0 }
  460. end;
  461.  
  462. { *************************************************************************** }
  463.  
  464. procedure make_menu ;
  465.         { create the menu bar }
  466.  
  467. var     lab_blank1,
  468.         lab_blank2,
  469.         pri_blank : integer;
  470.  
  471. begin
  472.  
  473. { reserve memory for the menu }
  474.         the_menu := New_Menu(30,'  About Labels  ') ;
  475.  
  476. { add the titles }
  477.         lab_title := Add_MTitle(the_menu,'  label ');
  478.         style_title := Add_MTitle(the_menu,'  style ');
  479.         siz_title := Add_MTitle(the_menu,'  size ');
  480.  
  481. { add the items to <labels> }
  482.         lab_make   := Add_MItem(the_menu,lab_title,'   create    ');
  483.         lab_remake := Add_MItem(the_menu,lab_title,'   modify    ');
  484.         lab_blank1 := Add_MItem(the_menu,lab_title,'-------------');
  485.         lab_print  := Add_MItem(the_menu,lab_title,'   print     ');
  486.         lab_blank2 := Add_MItem(the_menu,lab_title,'-------------');
  487.         lab_quit   := Add_MItem(the_menu,lab_title,'   quit      ');
  488.  
  489. { add the items to <printer> }
  490.         pri_cond := Add_MItem(the_menu,style_title,'  compressed   ');
  491.         pri_norm := Add_MItem(the_menu,style_title,'  pica         ');
  492.         pri_elon := Add_MItem(the_menu,style_title,'  elongated    ');
  493.         pri_blank:= Add_MItem(the_menu,style_title,'---------------');
  494.         pri_bold := Add_MItem(the_menu,style_title,'  bold         ');
  495.         pri_ital := Add_MItem(the_menu,style_title,'  italics      ');
  496.         pri_underline := Add_Mitem(the_menu,style_title,'  underlined   ');
  497.  
  498. { add the items to <size> }
  499.         siz_small  := Add_MItem(the_menu,siz_title,'  3.5" x 1"     ');
  500.         siz_large  := Add_MItem(the_menu,siz_title,'  4" x 1.5"     ');
  501.         siz_square := Add_MItem(the_menu,siz_title,'  2.75" x 2.75" ');
  502.         siz_other  := Add_MItem(the_menu,siz_title,'  other         ');
  503.  
  504. {  check mark the defaults }
  505.         Menu_Check(the_menu,pri_norm,TRUE);
  506.         Menu_Check(the_menu,siz_small,TRUE);
  507.  
  508. { disable the blank lines }
  509.         Menu_Disable(the_menu,lab_blank1);
  510.         Menu_Disable(the_menu,lab_blank2);
  511.         Menu_Disable(the_menu,pri_blank);
  512.         if CONDPRT = MARKER then Menu_Disable(the_menu,pri_cond);
  513.         if ELONGPRT= MARKER then Menu_Disable(the_menu,pri_elon);
  514.         if BOLD_ON = MARKER then Menu_Disable(the_menu,pri_bold);
  515.         if ITALIC_ON = MARKER then Menu_Disable(the_menu,pri_ital);
  516.         if UL_ON = MARKER then Menu_Disable(the_menu,pri_underline);
  517. end;
  518.  
  519. { *************************************************************************** }
  520.  
  521. procedure get_lab_size ( var width, len : real );
  522.         { user selected <other> for label size }
  523.  
  524.    const PROMPT = 'Enter label size';
  525.  
  526.    var  size_box : dialog_ptr; { the form itself }
  527.         i,
  528.         prompt_item,            { the prompt }
  529.         ok_button,              { the exit button }
  530.         help_button,            { the help button }
  531.         linew,linel,            { the edit lines - width and length }
  532.         pushed,                 { button the user pushed }
  533.         whole,frac : integer;   { whole and fractional part of number entered }
  534.  
  535.         str : str255 ;
  536.  
  537. begin
  538.  
  539. { create the object }
  540.         size_box := New_Dialog(6,0,0,34,10);
  541.  
  542. { add the prompt }
  543.      prompt_item := Add_Ditem(size_box,g_text,None,7,1,20,1,0,256*BLACK+128);
  544.      set_Dtext(size_box,prompt_item,PROMPT,System_font,TE_Center);
  545.  
  546. { add an ok button }
  547.         ok_button := Add_Ditem(size_box,G_Button,
  548.                 Selectable | Exit_Btn | Default,5,8,8,1,0,0);
  549.         set_Dtext(size_box,ok_button,'OK',System_font,TE_Center);
  550.  
  551. { add a help button }
  552.         help_button := Add_Ditem(size_box,G_Button,
  553.                 Selectable | Exit_Btn ,21,8,8,1,0,0);
  554.         set_Dtext(size_box,help_button,'HELP',System_font,TE_Center);
  555.  
  556. { add edit lines }
  557.            linel := Add_Ditem(size_box,G_Ftext,None,
  558.                 7,3,20,1,0,256*Black + 128 );
  559.            set_Dedit(size_box,linel,'length : _.__ inches','999',init_len,
  560.                      System_font,TE_Center);
  561.            linew := Add_Ditem(size_box,G_Ftext,None,
  562.                 7,5,20,1,0,256*Black + 128 );
  563.            set_Dedit(size_box,linew,' width : _.__ inches','999',init_wid,
  564.                      System_font,TE_Center);
  565.  
  566.     repeat
  567.         Center_dialog(size_box);       { reserve room to center the dialog }
  568.  
  569.         pushed := Do_Dialog(size_box,linel);    { display the box }
  570.  
  571.         End_dialog(size_box);                   { erase it }
  572.  
  573.         if pushed = help_button then begin
  574.            Obj_SetState(size_box,help_button,Normal,FALSE);
  575.            show_edit_funcs;
  576.         end;
  577.     until pushed = ok_button;
  578.  
  579.                                     { find out what was entered for width }
  580.         Get_DEdit(size_box,linew,init_wid);
  581.  
  582.                                     { convert width to real }
  583.         init_wid[0] := chr(3);
  584.         for i := 1 to 3 do
  585.            if not(init_wid[i] in ['1'..'9'] ) then
  586.                 init_wid[i] := '0';
  587.  
  588.         str := copy(init_wid,1,1);
  589.         whole := stoi(str);
  590.         str := copy(init_wid,2,2);
  591.         frac := stoi(str);
  592.         width := whole + frac / 100 ;
  593.  
  594. { find out what was entered for length }
  595.         Get_DEdit(size_box,linel,init_len);
  596.  
  597. { convert length to real }
  598.         init_len[0] := chr(3);
  599.         for i := 1 to 3 do
  600.            if not(init_len[i] in ['1'..'9']) then
  601.                 init_len[i] := '0';
  602.  
  603.         str := copy(init_len,1,1);
  604.         whole := stoi(str);
  605.         str := copy(init_len,2,2);
  606.         frac := stoi(str);
  607.         len := whole + frac / 100 ;
  608.  
  609. { release the space }
  610.         Delete_Dialog(size_box);
  611. end;
  612.  
  613. { *************************************************************************** }
  614.  
  615. procedure get_label(lines,chars,which:integer) ;
  616.         { gets lines of input from user }
  617.         { number of lines and length is determined by menu bar settings }
  618.  
  619.    const
  620.         prompt = 'Design your label';
  621.         PROMPT_LEN =  30;
  622.  
  623.         MAX_WID_FORM = 80;       { screen size }
  624.         MAX_HGT_FORM = 23;
  625.         MIN_WID_FORM = 36;
  626.         MIN_HGT_FORM = 7;
  627.  
  628.         BUTTON_LEN = 8;
  629.         BUTTON_HGT = 1;
  630.  
  631.    var  label_box : dialog_ptr; { the form itself }
  632.         prompt_item,            { the prompt }
  633.         border,                 { border box }
  634.         ok_button,help_button,  { the exit buttons }
  635.         pushed,                 { which button the user pushed }
  636.         form_wid,               { width of the form }
  637.         form_hgt,               { height of the form }
  638.         i : integer;            { loop controlled var }
  639.  
  640.         line : array[1..MAXLINES] of integer;   { the forms input lines }
  641.         template,valid,init : string[MAXCHARS];      { form setup strings }
  642.  
  643. begin
  644. { set up the form size }
  645.         form_wid := chars + 10;
  646.         if form_wid < MIN_WID_FORM then
  647.            form_wid := MIN_WID_FORM
  648.         else if form_wid > MAX_WID_FORM then
  649.            form_wid := MAX_WID_FORM;
  650.  
  651.  
  652.         form_hgt := lines + 8 ;
  653.         if form_hgt < MIN_HGT_FORM then
  654.            form_hgt := MIN_HGT_FORM
  655.         else if form_hgt > MAX_HGT_FORM then
  656.            form_hgt := MAX_HGT_FORM;
  657.  
  658.   if (lines < 1) or (chars < 1) then
  659.       pushed := Do_Alert(
  660.            '[3][    Label dimensions    |     are too small    ][ OK ]',1)
  661.   else if (Get_Rez = 0) and (form_wid > 40) then
  662.       pushed := Do_Alert(
  663.            '[3][  Label is too big  |  for low resolution  ][ OK ]',1)
  664.   else begin
  665.  
  666. { create the object }
  667.         label_box := New_Dialog(lines + 6,0,0,
  668.                                 form_wid,form_hgt);
  669.  
  670. { add the prompt }
  671.         prompt_item := Add_Ditem(label_box,g_text,None,
  672.              (form_wid-PROMPT_LEN)DIV 2,1,
  673.              PROMPT_LEN,1,0,256*BLACK+128);
  674.         set_Dtext(label_box,prompt_item,PROMPT,System_font,TE_Center);
  675.  
  676. { add a border box for the label }
  677.         border := Add_Ditem(label_box,G_Ibox,None,
  678.                   (form_wid-(chars+2)) div 2,3,chars+2,lines+2,1,4096*Black);
  679.  
  680. { add an ok button }
  681.         ok_button := Add_Ditem(label_box,G_Button,
  682.                 Selectable | Exit_Btn | Default,8,
  683.                 form_hgt-2,BUTTON_LEN,BUTTON_HGT,0,0);
  684.         set_Dtext(label_box,ok_button,'OK',System_font,TE_Center);
  685.  
  686. { add a help button }
  687.         help_button := Add_Ditem(label_box,G_Button,Selectable | Exit_Btn,
  688.                 form_wid-8-BUTTON_LEN,form_hgt-2,
  689.                 BUTTON_LEN,BUTTON_HGT,0,0);
  690.         set_Dtext(label_box,help_button,'HELP',System_font,TE_Center);
  691.  
  692. { set up template and validation strings }
  693.    template :=
  694.      '______________________________________________________________________';
  695.    valid    :=
  696.      'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX';
  697.         valid[0] := chr(chars);
  698.         template[0] := chr(chars);
  699.  
  700. { add edit lines }
  701.         for i := 1 to lines do
  702.         begin
  703.            line[i] := Add_Ditem(label_box,G_Ftext,None,
  704.                 1,3+i,form_wid - 2,1,0,
  705.                 256*Black + 128 );
  706.            if which = lab_remake then
  707.                 init := print_line[i]
  708.            else
  709.                 init := '';
  710.            set_Dedit(label_box,line[i],template,valid,init,
  711.                      System_font,TE_Center);
  712.         end;
  713.  
  714.         repeat
  715. { reserve room to center the dialog }
  716.             Center_dialog(label_box);
  717.  
  718. { display the box }
  719.             pushed := Do_Dialog(label_box,line[1]);
  720.  
  721. { erase it }
  722.             End_dialog(label_box);
  723.  
  724. { find out what was entered }
  725.             for i := 1 to lines do
  726.                 Get_DEdit(label_box,line[i],print_line[i]);
  727.  
  728.             if pushed = help_button then begin
  729.                 Obj_SetState(label_box,help_button,Normal,FALSE);
  730.                 which := lab_remake;
  731.                 show_edit_funcs;
  732.             end;
  733.  
  734.         until pushed = ok_button;
  735.  
  736. { release the space }
  737.         Delete_Dialog(label_box);
  738.  
  739.     end;  { else begin }
  740.  
  741. end; {of procedure get_label }
  742.  
  743. { *************************************************************************** }
  744. { main program }
  745.  
  746.   BEGIN
  747.     IF Init_Gem >= 0 THEN
  748.       BEGIN
  749.  
  750.         make_menu;
  751.         Draw_menu(the_menu);
  752.  
  753.         initialize;
  754.  
  755.         REPEAT
  756. { wait for message from GEM - menu selection }
  757.            which := Get_Event( E_Message, 0, 0, 0, 0,
  758.                    false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg,
  759.                    dummy, dummy, dummy, dummy, dummy, dummy ) ;
  760. { un-highlight it }
  761.            Menu_Normal(the_menu,msg[3]);
  762. { desk }
  763.            if msg[3] = DESK_TITLE  then
  764.                show_info
  765. { label }
  766.            else if msg[3] = lab_title then begin
  767.                                 { get labels or print 'em }
  768.                     if (msg[4] = lab_make) or (msg[4] = lab_remake) then
  769.                         get_label(numlines,numchars,msg[4])
  770.                     else if msg[4] = lab_print then
  771.                         print_label;
  772.            end { begin - lab_title }
  773. { styles }
  774.            else if msg[3] = style_title then begin
  775.                    if msg[4] in [pri_cond..pri_elon] then begin
  776.                                 { uncheck the old one }
  777.                         Menu_Check(the_menu,print_size,FALSE);
  778.                         print_size := msg[4];
  779.                                 { check the new one }
  780.                         Menu_Check(the_menu,print_size,TRUE);
  781.  
  782.                         case (msg[4] - pri_cond) of
  783.                            0: begin
  784.                                  cpi := CPI_COND;
  785.                                  lpi := LPI_COND;
  786.                               end;
  787.                            1: begin
  788.                                  cpi := CPI_NORM;
  789.                                  lpi := LPI_NORM;
  790.                               end;
  791.                            2: begin
  792.                                  cpi := CPI_ELON;
  793.                                  lpi := LPI_NORM;
  794.                               end;
  795.                            else: ;
  796.                         end; { case }
  797.                         set_size;
  798.                    end
  799.                             { bold, italics, and underline switches }
  800.                    else if msg[4] = pri_bold then begin
  801.                         bold := xor(bold,true);
  802.                         Menu_Check(the_menu,pri_bold,bold);
  803.                    end
  804.                    else if msg[4] = pri_ital then begin
  805.                         ital := xor(ital,true);
  806.                         Menu_Check(the_menu,pri_ital,ital);
  807.                    end
  808.                    else if msg[4] = pri_underline then begin
  809.                         underline := xor(underline,true);
  810.                         Menu_Check(the_menu,pri_underline,underline);
  811.                    end;
  812.  
  813.            end { begin - style_title }
  814. { size of label }
  815.            else if msg[3] = siz_title then begin
  816.                    if msg[4] in [siz_small..siz_other] then begin
  817.                         Menu_Check(the_menu,label_size,FALSE);
  818.                         label_size := msg[4];
  819.                         Menu_Check(the_menu,label_size,TRUE);
  820.  
  821.                         case (msg[4] - siz_small) of
  822.                            0:begin
  823.                               label_len := 1.0;
  824.                               label_wid := 3.5;
  825.                              end;
  826.                            1:begin
  827.                               label_len := 1.5;
  828.                               label_wid := 4.0;
  829.                              end;
  830.                            2:begin
  831.                               label_len := 2.75;
  832.                               label_wid := 2.75;
  833.                              end;
  834.                            3: get_lab_size(label_wid,label_len);
  835.                            else : ;
  836.                         end; { case }
  837.                         set_size;
  838.                    end; { if }
  839.            end; { begin - siz_title }
  840.  
  841.         UNTIL (msg[3] = lab_title) and (msg[4] = lab_quit) ;
  842.  
  843.        if C_Prnos then
  844.           send_control(SW_RESET);
  845.         Erase_menu(the_menu);
  846.         Delete_menu(the_menu);
  847.  
  848.        Exit_Gem ;
  849.       END ;
  850.   END.                          { Thats all folks }
  851.